home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / pasforma.arc / PASFORMA.PAS < prev   
Pascal/Delphi Source File  |  1989-03-19  |  57KB  |  1,270 lines
  1.  
  2.  PROGRAM pascalformatter;
  3. {
  4. | **                Pascal Program Formatter                       **
  5. | **                                                               **
  6. | **   by J. E. Crider, Shell Oil Company, Houston, Texas 77025    **
  7. | **                                                               **
  8. | **   Copyright (c) 1980 by Shell Oil Company.  Permission to     **
  9. | **   copy, modify, and distribute, but not for profit, is        **
  10. | **   hereby granted, provided that this note is included.        **
  11. |
  12. | Changes:
  13. |   The program has been updated to replace keywords according to
  14. |   the TURBO Pascal conventions.
  15. |
  16. |   This portable program formats Pascal programs and acceptable
  17. |   program fragments according to structured formatting principles
  18. |   [SIGPLAN Notices, Vol. 13, No. 11, Nov. 1978, pp. 15-22].
  19. |   The actions of the program are as follows:
  20. |
  21. |   PREPARATION:  For each structured statement that controls a
  22. |      structured statement, the program converts the controlled
  23. |      statement into a compound statement.  The inserted BEGIN/END
  24. |      pair are in capital letters.  A null statement (with semicolon)
  25. |      is inserted before the last END symbol of each program/
  26. |      procedure/function, if needed.  The semicolon forces the END
  27. |      symbol to appear on a line by itself.
  28. |
  29. |   FORMATTING:  Each structured statement that controls a simple
  30. |      statement is placed on a single line, as if it were a simple
  31. |      statement.  Otherwise, each structured statement is formatted
  32. |      in the following pattern (with indentation "indent"):
  33. |
  34. |            XXXXXX header XXXXXXXX
  35. |               XXXXXXXXXXXXXXXXXX
  36. |               XXXXX body XXXXXX
  37. |               XXXXXXXXXXXXXXXXXX
  38. |
  39. |      where the header is one of:
  40. |
  41. |            while <expression> do begin
  42. |            for <control variable> := <for list> do begin
  43. |            with <record variable list> do begin
  44. |            repeat
  45. |            if <expression> then begin
  46. |            else if <expression> then begin
  47. |            else begin
  48. |            case <expression> of
  49. |            <case label list>: begin
  50. |
  51. |      and the last line either begins with UNTIL or ends with END.
  52. |      Other program parts are formatted similarly.  The headers are:
  53. |
  54. |            <program/procedure/function heading>;
  55. |            label
  56. |            const
  57. |            type
  58. |            var
  59. |            begin
  60. |            (various for records and record variants)
  61. |
  62. |   COMMENTS:  Each comment that starts before or on a specified
  63. |      column on an input line (program constant "commthresh") is
  64. |      copied without shifting or reformatting.  Each comment that
  65. |      starts after "commthresh" is reformatted and left-justified
  66. |      following the aligned comment base column ("alcommbase").
  67. |
  68. |   LABELS:  Each statement label is justified to the left margin and
  69. |      is placed on a line by itself.
  70. |
  71. |   SPACES AND BLANK LINES:  Spaces not at line breaks are copied from
  72. |      the input.  Blank lines are copied from the input if they appear
  73. |      between statements (or appropriate declaration units).  A blank
  74. |      line is inserted above each significant part of each program/
  75. |      procedure/function if one is not already there.
  76. |
  77. |   CONTINUATION:  Lines that are too long for an output line are
  78. |      continued with additional indentation ("contindent").
  79. |
  80. |   INPUT FORM:  The program expects as input a program or program
  81. |      fragment in Standard Pascal.  A program fragment is acceptable
  82. |      if it consists of a sequence of (one or more) properly ordered
  83. |      program parts; examples are:  a statement part (that is, a
  84. |      compound statement), or a TYPE part and a VAR part followed by
  85. |      procedure declarations.  If the program fragment is in serious
  86. |      error, then the program may copy the remainder of the input file
  87. |      to the output file without significant modification.  Error
  88. |      messages may be inserted into the output file as comments.
  89. |}
  90.  
  91.     CONST
  92.        maxrwlen = 10;              { size of reserved word strings }
  93.        ordminchar = 32;            { ord of lowest char in char set }
  94.        ordmaxchar = 126;           { ord of highest char in char set }
  95.                                    {  Although this program uses the ASCII
  96.                                       character set, conversion to most other
  97.                                       character sets should be straightforward.
  98.                                       }
  99.  
  100.  {  The following parameters may be adjusted for the installation: }
  101.        maxinlen = 255;             { maximum width of input line + 1 }
  102.        maxoutlen = 80;             { maximum width of output line }
  103.        initmargin = 1;             { initial value of output margin }
  104.        commthresh = 4;             { column threshhold in input for comments to
  105.                                       be aligned }
  106.        alcommbase = 35;            { aligned comments in output start AFTER this
  107.                                       column }
  108.        indent = 3;                 { RECOMMENDED indentation increment }
  109.        contindent = 5;             { continuation indentation, >indent }
  110.        endspaces = 3;              { number of spaces to precede 'END' }
  111.        commindent = 3;             { comment continuation indentation }
  112.        line_number : INTEGER = 0;
  113.  
  114.     TYPE
  115.        natural = 0..MaxInt;
  116.        inrange = 0..maxinlen;
  117.        outrange = 0..maxoutlen;
  118.  
  119.        errortype = (longline, noendcomm, notquote, longword, notdo, notof,
  120.             notend, notthen, notbegin, notuntil, notsemicolon, notcolon,
  121.             notparen, noeof);
  122.  
  123.        chartype = (illegal, special, chapostrophe, chleftparen, chrightparen,
  124.             chperiod, digit, chcolon, chsemicolon, chlessthan, chgreaterthan,
  125.             letter, chleftbrace);
  126.  
  127.                                    { for reserved word recognition }
  128.        resword = (                 { reserved words ordered by length }
  129.             rwif, rwdo, rwof, rwto, rwin, rwor,
  130.                                    { length: 2 }
  131.             rwend, rwfor, rwvar, rwdiv, rwmod, rwset, rwand, rwnot, rwnil,
  132.                                    { length: 3 }
  133.             rwthen, rwelse, rwwith, rwgoto, rwcase, rwtype, rwfile, rwuses,
  134.             rwunit,                { length: 4 }
  135.             rwbegin, rwuntil, rwwhile, rwarray, rwconst, rwlabel, rwvalue,
  136.                                    { length: 5 }
  137.             rwrepeat, rwrecord, rwdownto, rwpacked,rwmodule,
  138.                                    { length: 6 }
  139.             rwprogram,             { length: 7 }
  140.             rwfunction,            { length: 8 }
  141.             rwotherwise,rwprocedure,
  142.                                    { length: 9 }
  143.             rwx);                  { length: 10 for table sentinel }
  144.        rwstring = PACKED ARRAY [1..maxrwlen] OF CHAR;
  145.  
  146.        firstclass = (              { class of word if on new line }
  147.             newclause,             { start of new clause }
  148.             continue,              { continuation of clause }
  149.             alcomm,                { start of aligned comment }
  150.             contalcomm,            { continuation of aligned comment }
  151.             uncomm,                { start of unaligned comment }
  152.             contuncomm,            { continuation of unaligned comment }
  153.             stmtlabel);            { statement label }
  154.        wordtype = RECORD           { data record for word }
  155.           whenfirst: firstclass;   { class of word if on new line }
  156.           puncfollows: BOOLEAN;    { to reduce dangling punctuation }
  157.           blanklncount: natural;   { number of preceding blank lines }
  158.           spaces: INTEGER;         { number of spaces preceding word }
  159.           base: -9..maxinlen;      { inlinexx.buf[base] precedes word }
  160.           size: inrange   END;     { length of word in inlinexx.buf }
  161.  
  162.        symboltype = (              { symbols for syntax analysis }
  163.             semicolon, sybegin, syend,
  164.                                    { three insertable symbols first }
  165.             syif, sydo, syof, sythen, syelse, sygoto, sycase, syuntil, syrepeat,
  166.             syrecord, forwhilewith, progprocfunc, declarator, otherword,
  167.             othersym, leftparen, rightparen, period, syotherwise, sysubrange,
  168.             intconst, colon, ident, comment, syeof);
  169.        inserttype = semicolon..syend;
  170.        symbolset = SET OF symboltype;
  171.                                    { *** NOTE: set size of 0..26 REQUIRED for
  172.                                       symbolset! }
  173.  
  174.     VAR
  175.        Input,Output : TEXT[$800];
  176.        response : STRING[10];
  177.        no_error_output : BOOLEAN;
  178.        infilename,outfilename : STRING[80];
  179.        inlinexx: RECORD            { input line data }
  180.           endoffile: BOOLEAN;      { end of file on input? }
  181.           ch: CHAR;                { current char, buf[index] }
  182.           index: inrange;          { subscript of current char }
  183.           len: natural;            { length of input line in buf }
  184.                                    { string ';BEGINEND' in buf[-8..0] }
  185.           buf: ARRAY [-8..maxinlen] OF CHAR   END;
  186.        outline: RECORD             { output line data }
  187.           blanklns: natural;       { number of preceding blank lines }
  188.           len: outrange;           { number of chars in buf }
  189.           buf: ARRAY [1..maxoutlen] OF CHAR   END;
  190.        WORD: wordtype;             { current word }
  191.        margin: outrange;           { left margin }
  192.        lnpending: BOOLEAN;         { new line before next symbol? }
  193.        symbol: symboltype;         { current symbol }
  194.  
  195.   { Structured Constants }
  196.        headersyms: symbolset;      { headers for program parts }
  197.        strucsyms: symbolset;       { symbols that begin structured statements }
  198.        stmtbeginsyms: symbolset;   { symbols that begin statements }
  199.        stmtendsyms: symbolset;     { symbols that follow statements }
  200.        stopsyms: symbolset;        { symbols that stop expression scan }
  201.        recendsyms: symbolset;      { symbols that stop record scan }
  202.        datawords: symbolset;       { to reduce dangling punctuation }
  203.        newword: ARRAY [inserttype] OF wordtype;
  204.        instring: PACKED ARRAY [1..9] OF CHAR;
  205.        firstrw: ARRAY [1..maxrwlen] OF resword;
  206.        rwword: ARRAY [rwif..rwprocedure] OF rwstring;
  207.        rwsy: ARRAY [rwif..rwprocedure] OF symboltype;
  208.        charclass: ARRAY [CHAR] OF chartype;
  209.                                    { above is portable form; possible ASCII form
  210.                                       is: }
  211.                                    {    charclass: array [' '..'~'] of chartype;
  212.                                       }
  213.        symbolclass: ARRAY [chartype] OF symboltype;
  214.  
  215.     PROCEDURE strucconsts;         { establish values of structured constants }
  216.  
  217.        VAR
  218.           i: ordminchar..ordmaxchar;
  219.                                    { loop index }
  220.           ch: CHAR;                { loop index }
  221.  
  222.        PROCEDURE buildinsert (symbol: inserttype;
  223.             inclass: firstclass;
  224.             inpuncfollows: BOOLEAN;
  225.             inspaces, inbase: INTEGER;
  226.             insize: inrange);
  227.  
  228.           BEGIN
  229.              WITH newword[symbol] DO BEGIN
  230.                 whenfirst := inclass;
  231.                 puncfollows := inpuncfollows;
  232.                 blanklncount := 0;
  233.                 spaces := inspaces;
  234.                 base := inbase;
  235.                 size := insize   END;
  236.              END;                  { buildinsert }
  237.  
  238.        PROCEDURE buildrw (rw: resword;
  239.             symword: rwstring;
  240.             symbol: symboltype);
  241.  
  242.           BEGIN
  243.              rwword[rw] := symword;{ reserved word string }
  244.              rwsy[rw] := symbol;   { map to symbol }
  245.              END;                  { buildrw }
  246.  
  247.        BEGIN                       { strucconsts }
  248.                                    { symbol sets for syntax analysis }
  249.           headersyms := [progprocfunc, declarator, sybegin, syeof];
  250.           strucsyms := [sycase, syrepeat, syif, forwhilewith];
  251.           stmtbeginsyms := strucsyms + [sybegin, ident, sygoto, syotherwise];
  252.           stmtendsyms := [semicolon, syend, syuntil, syelse, syeof];
  253.           stopsyms := headersyms + strucsyms + stmtendsyms + [sygoto];
  254.           recendsyms := [rightparen, syend, syeof];
  255.  
  256.           datawords := [otherword, intconst, ident, syend];
  257.  
  258.                                    { words for insertable symbols }
  259.           buildinsert (semicolon, continue, FALSE, 0, -9, 1);
  260.           buildinsert (sybegin, continue, FALSE, 1, -8, 5);
  261.           buildinsert (syend, newclause, TRUE, endspaces, -3, 3);
  262.           instring := ';        '; {';BEGINEND'}
  263.  
  264.                                    { constants for recognizing reserved words }
  265.           firstrw[1] := rwif;      { length: 1 }
  266.           firstrw[2] := rwif;      { length: 2 }
  267.           buildrw (rwif, 'IF        ', syif);
  268.           buildrw (rwdo, 'DO        ', sydo);
  269.           buildrw (rwof, 'OF        ', syof);
  270.           buildrw (rwto, 'TO        ', othersym);
  271.           buildrw (rwin, 'IN        ', othersym);
  272.           buildrw (rwor, 'OR        ', othersym);
  273.           firstrw[3] := rwend;     { length: 3 }
  274.           buildrw (rwend, 'END       ', syend);
  275.           buildrw (rwfor, 'FOR       ', forwhilewith);
  276.           buildrw (rwvar, 'VAR       ', declarator);
  277.           buildrw (rwdiv, 'DIV       ', othersym);
  278.           buildrw (rwmod, 'MOD       ', othersym);
  279.           buildrw (rwset, 'SET       ', othersym);
  280.           buildrw (rwand, 'AND       ', othersym);
  281.           buildrw (rwnot, 'NOT       ', othersym);
  282.           buildrw (rwnil, 'NIL       ', otherword);
  283.           firstrw[4] := rwthen;    { length: 4 }
  284.           buildrw (rwthen, 'THEN      ', sythen);
  285.           buildrw (rwelse, 'ELSE      ', syelse);
  286.           buildrw (rwwith, 'WITH      ', forwhilewith);
  287.           buildrw (rwgoto, 'GOTO      ', sygoto);
  288.           buildrw (rwcase, 'CASE      ', sycase);
  289.           buildrw (rwtype, 'TYPE      ', declarator);
  290.           buildrw (rwfile, 'FILE      ', othersym);
  291.           buildrw (rwuses, 'USES      ', declarator);
  292.           buildrw (rwunit, 'UNIT      ', declarator);
  293.           firstrw[5] := rwbegin;   { length: 5 }
  294.           buildrw (rwbegin, 'BEGIN     ', sybegin);
  295.           buildrw (rwuntil, 'UNTIL     ', syuntil);
  296.           buildrw (rwwhile, 'WHILE     ', forwhilewith);
  297.           buildrw (rwarray, 'ARRAY     ', othersym);
  298.           buildrw (rwconst, 'CONST     ', declarator);
  299.           buildrw (rwlabel, 'LABEL     ', declarator);
  300.           buildrw (rwvalue, 'VALUE     ', declarator);
  301.           firstrw[6] := rwrepeat;  { length: 6 }
  302.           buildrw (rwrepeat, 'REPEAT    ', syrepeat);
  303.           buildrw (rwrecord, 'RECORD    ', syrecord);
  304.           buildrw (rwdownto, 'DOWNTO    ', othersym);
  305.           buildrw (rwpacked, 'PACKED    ', othersym);
  306.           buildrw (rwmodule, 'MODULE    ',progprocfunc);
  307.           firstrw[7] := rwprogram; { length: 7 }
  308.           buildrw (rwprogram, 'PROGRAM   ', progprocfunc);
  309.           firstrw[8] := rwfunction;{ length: 8 }
  310.           buildrw (rwfunction, 'FUNCTION  ', progprocfunc);
  311.           firstrw[9] := rwotherwise;
  312.                                    { length: 9 }
  313.           buildrw (rwotherwise, 'OTHERWISE ', syotherwise);
  314.           buildrw (rwprocedure, 'PROCEDURE ', progprocfunc);
  315.           firstrw[10] := rwx;      { length: 10 for table sentinel }
  316.  
  317.                                    { constants for lexical scan }
  318.           FOR i := ordminchar TO ordmaxchar DO BEGIN
  319.              charclass[Chr (i)] := illegal   END;
  320.           FOR ch := 'a' TO 'z' DO BEGIN
  321.                                    { !!! implementation-dependent!  (but can be
  322.                                       replaced with 52 explicit assignments) }
  323.              charclass[ch] := letter;
  324.              charclass[UpCase(ch)] := letter   END;
  325.           charclass['_'] := letter;
  326.           charclass['#'] := letter;
  327.           FOR ch := '0' TO '9' DO charclass[ch] := digit;
  328.           charclass[' '] := special;
  329.           charclass['$'] := special;
  330.           charclass[''''] := chapostrophe;
  331.           charclass['('] := chleftparen;
  332.           charclass[')'] := chrightparen;
  333.           charclass['*'] := special;
  334.           charclass['+'] := special;
  335.           charclass['-'] := special;
  336.           charclass['.'] := chperiod;
  337.           charclass['/'] := special;
  338.           charclass[':'] := chcolon;
  339.           charclass[';'] := chsemicolon;
  340.           charclass['<'] := chlessthan;
  341.           charclass['='] := special;
  342.           charclass['>'] := chgreaterthan;
  343.           charclass['@'] := special;
  344.           charclass['['] := special;
  345.           charclass[']'] := special;
  346.           charclass['^'] := special;
  347.           charclass['{'] := chleftbrace;
  348.           symbolclass[illegal] := othersym;
  349.           symbolclass[special] := othersym;
  350.           symbolclass[chapostrophe] := otherword;
  351.           symbolclass[chleftparen] := leftparen;
  352.           symbolclass[chrightparen] := rightparen;
  353.           symbolclass[chperiod] := period;
  354.           symbolclass[digit] := intconst;
  355.           symbolclass[chcolon] := colon;
  356.           symbolclass[chsemicolon] := semicolon;
  357.           symbolclass[chlessthan] := othersym;
  358.           symbolclass[chgreaterthan] := othersym;
  359.           symbolclass[letter] := ident;
  360.           symbolclass[chleftbrace] := comment;
  361.  
  362.           END;                     { strucconsts }
  363.  
  364. { writeline/writeerror/readline convert between files and lines. }
  365.  
  366.     PROCEDURE writeline;           { write buffer into output file }
  367.  
  368.        VAR
  369.           i: outrange;             { loop index }
  370.  
  371.        BEGIN
  372.           WITH outline DO BEGIN
  373.              WHILE blanklns > 0 DO BEGIN
  374.                 Writeln (Output);
  375.                 blanklns := blanklns - 1   END;
  376.              IF len > 0 THEN BEGIN
  377.                 FOR i := 1 TO len DO Write (Output, buf[i]);
  378.                 Writeln (Output);
  379.                 len := 0   END   END;
  380.           END;                     { writeline }
  381.  
  382.     PROCEDURE writeerror (error: errortype);
  383.                                    { report error to output }
  384.  
  385.        VAR
  386.           i, ix: inrange;          { loop index, limit }
  387.  
  388.        BEGIN
  389.           IF NOT no_error_output THEN BEGIN
  390.              writeline;
  391.              Write (Output, ' (*  !!! error, ');
  392.              CASE error OF
  393.                 longline:     Write (Output, 'shorter line');
  394.                 noendcomm:    Write (Output, 'end of comment');
  395.                 notquote:     Write (Output, 'final "''" on line');
  396.                 longword:     Write (Output, 'shorter word');
  397.                 notdo:        Write (Output, '"do"');
  398.                 notof:        Write (Output, '"of"');
  399.                 notend:       Write (Output, '"end"');
  400.                 notthen:      Write (Output, '"then"');
  401.                 notbegin:     Write (Output, '"begin"');
  402.                 notuntil:     Write (Output, '"until"');
  403.                 notsemicolon: Write (Output, '";"');
  404.                 notcolon:     Write (Output, '":"');
  405.                 notparen:     Write (Output, '")"');
  406.                 noeof:        Write (Output, 'end of file')   END;
  407.              Write (Output, ' expected');
  408.              IF error >= longword THEN BEGIN
  409.                 Write (Output, ', not "');
  410.                 WITH inlinexx, WORD DO BEGIN
  411.                    IF size > maxrwlen THEN ix := maxrwlen
  412.                    ELSE ix := size;
  413.                    FOR i := 1 TO ix DO Write (Output, buf[base + i])   END;
  414.                 Write (Output, '"')   END;
  415.              IF error = noeof THEN Write (Output, ', FORMATTING STOPS');
  416.              Writeln (Output, ' !!!  *)');
  417.              END
  418.           ELSE BEGIN
  419.              Write (Con,line_number, ' (*  !!! error, ');
  420.              CASE error OF
  421.                 longline:     Write (Con, 'shorter line');
  422.                 noendcomm:    Write (Con, 'end of comment');
  423.                 notquote:     Write (Con, 'final "''" on line');
  424.                 longword:     Write (Con, 'shorter word');
  425.                 notdo:        Write (Con, '"do"');
  426.                 notof:        Write (Con, '"of"');
  427.                 notend:       Write (Con, '"end"');
  428.                 notthen:      Write (Con, '"then"');
  429.                 notbegin:     Write (Con, '"begin"');
  430.                 notuntil:     Write (Con, '"until"');
  431.                 notsemicolon: Write (Con, '";"');
  432.                 notcolon:     Write (Con, '":"');
  433.                 notparen:     Write (Con, '")"');
  434.                 noeof:        Write (Con, 'end of file')   END;
  435.              Write (Con, ' expected');
  436.              IF error >= longword THEN BEGIN
  437.                 Write (Con, ', not "');
  438.                 WITH inlinexx, WORD DO BEGIN
  439.                    IF size > maxrwlen THEN ix := maxrwlen
  440.                    ELSE ix := size;
  441.                    FOR i := 1 TO ix DO Write (Con, buf[base + i])   END;
  442.                 Write (Con, '"')   END;
  443.              IF error = noeof THEN Write (Con, ', FORMATTING STOPS');
  444.              Writeln (Con, ' !!!  *)');
  445.              END;
  446.  
  447.           END;                     { writeerror }
  448.  
  449.     PROCEDURE readline;            { read line into input buffer }
  450.  
  451.        VAR
  452.           c: CHAR;                 { input character }
  453.           nonblank: BOOLEAN;       { is char other than space? }
  454.  
  455.        BEGIN
  456.           WITH inlinexx DO BEGIN
  457.              len := 0;
  458.              IF Eof (Input) THEN endoffile := TRUE
  459.              ELSE BEGIN            { get next line }
  460.                 WHILE NOT Eoln (Input) DO BEGIN
  461.                    Read (Input, c);
  462.                    IF c < ' ' THEN BEGIN
  463.                                    { convert ASCII control chars (except leading
  464.                                       form feed) to spaces }
  465.                       IF c = Chr (9) THEN BEGIN
  466.                                    { ASCII tab char }
  467.                          c := ' '; { add last space at end }
  468.                          WHILE len MOD 8 <> 7 DO BEGIN
  469.                             len := len + 1;
  470.                             IF len < maxinlen THEN buf[len] := c   END;
  471.                          END       { end tab handling }
  472.                       ELSE IF (c <> Chr (12)) OR (len > 0) THEN c := ' ';
  473.                       END;         { end ASCII control char conversion }
  474.                    len := len + 1;
  475.                    IF len < maxinlen THEN buf[len] := c   END;
  476.                 Readln (Input);
  477.                 line_number := line_number+1;
  478.                 IF len >= maxinlen THEN BEGIN
  479.                                    { input line too long }
  480.                    writeerror (longline);
  481.                    len := maxinlen - 1   END;
  482.                 nonblank := FALSE;
  483.                 REPEAT             { trim line }
  484.                    IF len = 0 THEN nonblank := TRUE
  485.                    ELSE IF buf[len] <> ' ' THEN nonblank := TRUE
  486.                    ELSE len := len - 1
  487.                    UNTIL nonblank   END;
  488.              len := len + 1;       { add exactly ONE trailing blank }
  489.              buf[len] := ' ';
  490.              index := 0   END;
  491.           END;                     { readline }
  492.  
  493. { startword/finishword/copyword convert between lines and words.
  494.    auxiliary procedures getchar/nextchar precede. }
  495.  
  496.     PROCEDURE getchar;             { get next char from input buffer }
  497.  
  498.        BEGIN
  499.           WITH inlinexx DO BEGIN
  500.              index := index + 1;
  501.              ch := buf[index]   END;
  502.           END;                     { getchar }
  503.  
  504.     FUNCTION nextchar: CHAR;       { look at next char in input buffer }
  505.  
  506.        BEGIN
  507.           WITH inlinexx DO nextchar := buf[index + 1];
  508.           END;                     { nextchar }
  509.  
  510.     PROCEDURE startword (startclass: firstclass);
  511.                                    { note beginning of word, and count preceding
  512.                                       lines and spaces }
  513.  
  514.        VAR
  515.           first: BOOLEAN;          { is word the first on input line? }
  516.  
  517.        BEGIN
  518.           first := FALSE;
  519.           WITH inlinexx, WORD DO BEGIN
  520.              whenfirst := startclass;
  521.              blanklncount := 0;
  522.              WHILE (index >= len) AND NOT endoffile DO BEGIN
  523.                 IF len = 1 THEN blanklncount := blanklncount + 1;
  524.                 IF startclass = contuncomm THEN writeline
  525.                 ELSE first := TRUE;
  526.                 readline;          { with exactly ONE trailing blank }
  527.                 getchar;           { ASCII:        if ch = chr (12) then begin [
  528.                                       ASCII form feed char ] writeline; writeln
  529.                                       (output, chr (12)); blanklncount := 0;
  530.                                       getchar   end;  [ end ASCII form feed
  531.                                       handling }
  532.                 END;
  533.              spaces := 0;          { count leading spaces }
  534.              IF NOT endoffile THEN BEGIN
  535.                 WHILE ch = ' ' DO BEGIN
  536.                    spaces := spaces + 1;
  537.                    getchar   END   END;
  538.              IF first THEN spaces := 1;
  539.              base := index - 1   END;
  540.           END;                     { startword }
  541.  
  542.     PROCEDURE finishword;          { note end of word }
  543.  
  544.        BEGIN
  545.           WITH inlinexx, WORD DO BEGIN
  546.              puncfollows := (symbol IN datawords) AND (ch <> ' ');
  547.              size := index - base - 1   END;
  548.           END;                     { finishword }
  549.  
  550.     PROCEDURE copyword (newline: BOOLEAN;
  551.          WORD: wordtype);          { copy word from input buffer into output
  552.                                       buffer }
  553.  
  554.        VAR
  555.           i: INTEGER;              { outline.len excess, loop index }
  556.  
  557.        BEGIN
  558.           WITH WORD, outline DO BEGIN
  559.              i := maxoutlen - len - spaces - size;
  560.              IF newline OR (i < 0) OR ((i = 0) AND puncfollows) THEN writeline;
  561.              IF len = 0 THEN BEGIN { first word on output line }
  562.                 blanklns := blanklncount;
  563.                 CASE whenfirst OF  { update LOCAL word.spaces }
  564.                    newclause:  spaces := margin;
  565.                    continue:   spaces := margin + contindent;
  566.                    alcomm:     spaces := alcommbase;
  567.                    contalcomm: spaces := alcommbase + commindent;
  568.                    uncomm:     spaces := base;
  569.                    contuncomm: ;   { spaces := spaces }
  570.                    stmtlabel:  spaces := initmargin   END;
  571.                 IF spaces + size > maxoutlen THEN BEGIN
  572.                    spaces := maxoutlen - size;
  573.                                    { reduce spaces }
  574.                    IF spaces < 0 THEN BEGIN
  575.                       writeerror (longword);
  576.                       size := maxoutlen;
  577.                       spaces := 0   END   END   END;
  578.              FOR i := 1 TO spaces DO BEGIN
  579.                                    { put out spaces }
  580.                 len := len + 1;
  581.                 buf[len] := ' '   END;
  582.              FOR i := 1 TO size DO BEGIN
  583.                                    { copy actual word }
  584.                 len := len + 1;
  585.                 buf[len] := inlinexx.buf[base + i]   END   END;
  586.           END;                     { copyword }
  587.  
  588. { docomment/copysymbol/insert/getsymbol/findsymbol convert between
  589.    words and symbols. }
  590.  
  591.     PROCEDURE docomment;           { copy aligned or unaligned comment }
  592.  
  593.        PROCEDURE copycomment (commclass: firstclass;
  594.             commbase: inrange);    { copy words of comment }
  595.  
  596.           VAR
  597.              endcomment: BOOLEAN;  { end of comment? }
  598.  
  599.           BEGIN
  600.              WITH WORD DO BEGIN    { copy comment begin symbol }
  601.                 whenfirst := commclass;
  602.                 spaces := commbase - outline.len;
  603.                 copyword ((spaces < 0) OR (blanklncount > 0), WORD)   END;
  604.              commclass := Succ (commclass);
  605.              WITH inlinexx DO BEGIN
  606.                 REPEAT             { loop for successive words }
  607.                    startword (commclass);
  608.                    endcomment := endoffile;
  609.                                    { premature end? }
  610.                    IF endcomment THEN writeerror (noendcomm)
  611.                    ELSE BEGIN
  612.                       REPEAT
  613.                          IF ch = '*' THEN BEGIN
  614.                             getchar;
  615.                             IF ch = ')' THEN BEGIN
  616.                                endcomment := TRUE;
  617.                                getchar   END   END
  618.                          ELSE IF ch = '}' THEN BEGIN
  619.                             endcomment := TRUE;
  620.                             getchar   END
  621.                          ELSE getchar
  622.                          UNTIL (ch = ' ') OR endcomment   END;
  623.                    finishword;
  624.                    copyword (FALSE, WORD)
  625.                    UNTIL endcomment   END;
  626.              END;                  { copycomment }
  627.  
  628.        BEGIN                       { docomment }
  629.           IF WORD.base < commthresh THEN BEGIN
  630.                                    { copy comment without alignment }
  631.              copycomment (uncomm, WORD.base)   END
  632.           ELSE BEGIN               { align and format comment }
  633.              copycomment (alcomm, alcommbase)   END;
  634.           END;                     { docomment }
  635.  
  636.     PROCEDURE copysymbol (symbol: symboltype;
  637.          WORD: wordtype);          { copy word(s) of symbol }
  638.  
  639.        BEGIN
  640.           IF symbol = comment THEN BEGIN
  641.              docomment;            { NOTE: docomment uses global word! }
  642.              lnpending := TRUE   END
  643.           ELSE IF symbol = semicolon THEN BEGIN
  644.              copyword (FALSE, WORD);
  645.              lnpending := TRUE   END
  646.           ELSE BEGIN
  647.              copyword (lnpending, WORD);
  648.              lnpending := FALSE   END;
  649.           END;                     { copysymbol }
  650.  
  651.     PROCEDURE Insert (newsymbol: inserttype);
  652.                                    { copy word for inserted symbol into output
  653.                                       buffer }
  654.  
  655.        BEGIN
  656.           copysymbol (newsymbol, newword[newsymbol]);
  657.           END;                     { insert }
  658.  
  659.     PROCEDURE getsymbol;           { get next non-comment symbol }
  660.  
  661.        PROCEDURE findsymbol;       { find next symbol in input buffer }
  662.  
  663.           VAR
  664.              chclass: chartype;    { classification of leading char }
  665.  
  666.           PROCEDURE checkresword;  { check if current identifier is reserved
  667.                                       word/symbol }
  668.  
  669.              CONST
  670.                 keyword_size = 226;
  671.                 keyword_len = 15;
  672.                 keyword : ARRAY[1..keyword_size] OF ARRAY[1..2] OF STRING[
  673.                      keyword_len] = ( ('ABORT','Abort'),('ABSOLUTE','Absolute'),
  674.                      ('ADDR','Addr'), ('ADR',''),('ADRMEM','AdrMem'),('ADS',''),
  675.                      ('ADSMEM','AdsMem'), ('AND',''), ('APPEND','Append'), (
  676.                      'ARCTAN','Arctan'), ('ARRAY',''), ('ASSIGN', 'Assign'), (
  677.                      'AUX','Aux'), ('AUXINPTR','AuxInPtr'), ( 'AUXOUTPTR',
  678.                      'AuxOutPtr'), ('BEGIN',''), ('BLOCKREAD', 'BlockRead'), (
  679.                      'BLOCKWRITE','BlockWrite'), ('BOOLEAN',''), ('BREAK',''),
  680.                      ('BUFLEN','BufLen'), ('BYTE',''), ('BYWORD','ByWord'), (
  681.                      'CASE',''), ( 'CHAIN','Chain'), ('CHAR',''), ('CHDIR',
  682.                      'ChDir'), ('CHR','Chr'), ('CLOSE', 'Close'), ('CLREOL',
  683.                      'ClrEol'), ('CLRSCR','ClrScr'), ('CON', 'Con'), ('CONCAT',
  684.                      'Concat'), ('CONINPTR','ConInPtr'), ( 'CONOUTPTR',
  685.                      'ConOutPtr'), ('CONST',''), ('CONSTPTR', 'ConstPtr'), (
  686.                      'COPY','Copy'), ('COPYLST','CopyLst'),('COPYSTR','CopyStr')
  687.                      , ('COS','Cos'), ('CRTEXIT', 'CrtExit'), ('CRTINIT',
  688.                      'CrtInit'), ('CSEG','CSeg'), ('CYCLE',''),('DECODE',
  689.                      'Decode'), ( 'DELAY','Delay'), ('DELETE','Delete'), (
  690.                      'DELLINE', 'DelLine'), ('DISPOSE','Dispose'), ('DIV',''), (
  691.                      'DO',''), ('DOWNTO',''), ( 'DRAW','Draw'), ('DSEG','DSeg'),
  692.                      ('ELSE',''), ('ENCODE','Encode'), ('END',''), ( 'EOF',
  693.                      'Eof'), ('EOLN','Eoln'), ('ERASE','Erase'), ('EVAL','Eval')
  694.                      , ('EXECUTE', 'Execute'), ('EXP','Exp'), ('EXTERN',''), (
  695.                      'EXTERNAL',''), ('FALSE',''), ( 'FILE',''), ('FILEPOS',
  696.                      'FilePos'), ('FILESIZE','FileSize'), ('FILLC','FillC'), (
  697.                      'FILLCHAR','FillChar'), ('FILLSC','FillSC'), ('FLUSH',
  698.                      'Flush'), ('FOR',''), ( 'FORWARD',''), ('FRAC','Frac'), (
  699.                      'FREEMEM','FreeMem'), ( 'FUNCTION',''), ('GETDIR','GetDir')
  700.                      , ('GETMEM','GetMem'), ('GOTO',''), ( 'GOTOXY','GotoXY'), (
  701.                      'GRAPHBACKGROUND','GraphBackGround'), ('GRAPHCOLORMODE',
  702.                      'GraphColorMode'), ('GRAPHMODE', 'GraphMode'), (
  703.                      'GRAPHWINDOW','GraphWindow'), ('HALT', 'Halt'), ('HEAPSTR',
  704.                      'HeapStr'), ('HI','Hi'), ('HIBYTE','HiByte'),
  705.                      ('HIRES', 'HiRes'), ('HIRESCOLOR',
  706.                      'HiResColor'), ('IF',''), ('IN','') , ('INLINE','InLine'),
  707.                      ('INPUT','Input'), ('INSERT', 'Insert'), ('INSLINE',
  708.                      'InsLine'), ('INT',''), ('INTEGER', ''), ('INTR','Intr'), (
  709.                      'IORESULT','IOResult'), ('KBD', 'Kbd'), ('KEYPRESSED',
  710.                      'KeyPressed'), ('LABEL',''), ( 'LENGTH','Length'), ('LN',
  711.                      'Ln'), ('LO','Lo'), ( 'LONGFILEPOS','LongFilePos'), (
  712.                      'LONGFILESIZE', 'LongFileSize'), ('LONGSEEK','LongSeek'),
  713.                      ('LOBYTE','LoByte'),('LOWER','Lower'),
  714.                      ('LOWVIDEO', 'LowVideo'), ('LST','Lst'),
  715.                      ('LSTOUTPTR','LstOutPtr'), ('LSTRING',''), ( 'MARK','Mark')
  716.                      , ('MAXAVAIL','MaxAvail'), ('MAXINT', 'MaxInt'), ('MEM',
  717.                      'Mem'), ('MEMAVAIL','MemAvail'), ('MEMW', 'MemW'), (
  718.                      'MKDIR','MkDir'), ('MOD',''), ('MODULE',''), ('MOVE',
  719.                      'Move'), ('MOVEL','MoveL'),('MOVER','MoveR'), ('MOVESL',
  720.                      'MoveSL'),('MOVESR','MoveSR'), ('MSDOS','MSDos'), ('NEW',
  721.                      'New'), ('NIL',''), ('NORMVIDEO','NormVideo'), ( 'NOSOUND',
  722.                      'NoSound'), ('NOT',''), ('NULL',''),
  723.                      ('ODD','Odd'), ('OF',''), ('OFS',
  724.                      'Ofs'), ('OR',''), ('ORD','Ord'), ('OTHERWISE',''),
  725.                      ('OUTPUT','Output'), (
  726.                      'OVRPATH','OvrPath'), ('PACKED',''), ('PALETTE','Palette'),
  727.                      ('PARAMCOUNT','ParamCount'), ('PARAMSTR','ParamStr'), (
  728.                      'PI','Pi'), ('PLOT', 'Plot'), ('PORT','Port'), ('PORTW',
  729.                      'PortW'), ('POS','Pos'), ('POSITN','Positn'), ('PRED',''),
  730.                      ('PROCEDURE',''), ('PROGRAM',''), ('PTR', 'Ptr'), (
  731.                      'PUBLIC',''), ('RANDOM','Random'), ('RANDOMIZE',
  732.                      'Randomize'), ( 'READ','Read'), ('READLN','Readln'), (
  733.                      'REAL',''), ( 'RECORD',''), ('RELEASE','Release'), (
  734.                      'RENAME','Rename'), ( 'REPEAT',''), ('RESET','Reset'), (
  735.                      'RETURN',''), ('REWRITE','Rewrite'), ('RMDIR','RmDir'), (
  736.                      'ROUND','Round'), ('SCANEQ','ScanEQ'),('SCANNE','ScanNE'),
  737.                      ('SEEK','Seek'), ('SEG','Seg'), ('SET', ''), ('SHL','ShL'),
  738.                      ('SHR','ShR'), ('SIN','Sin'), ( 'SIZEOF','SizeOf'), (
  739.                      'SOUND','Sound'), ('SQR','Sqr'), ( 'SQRT','Sqrt'), ('SSEG',
  740.                      'SSeg'), ('STATIC',''), ('STR','Str'), ('STRING', ''), (
  741.                      'SUCC','Succ'),('SUPER',''),
  742.                      ('SWAP','Swap'), ('TEXT',''), (
  743.                      'TEXTBACKGROUND','TextBackGround'), ('TEXTCOLOR',
  744.                      'TextColor'), ('TEXTMODE','TextMode'), ('THEN',''), ('TO',
  745.                      ''), ('TRM','Trm'), ('TRUE',''), ('TRUNC','Trunc'), (
  746.                      'TRUNCATE','Truncate'), ( 'TYPE',''), ('UNTIL',''), (
  747.                      'UPCASE','UpCase'), ('UPPER','Upper'),('USES',''), ('USR',
  748.                      'Usr'), ('USRINPTR','UsrInPtr'), ('USROUTPTR','UsrOutPtr'),
  749.                      ('VAL','Val'), ('VALUE',''), ('VAR',''), ('WHEREX',
  750.                      'WhereX'), ('WHEREY', 'WhereY'), ('WHILE',''), ('WINDOW',
  751.                      'Window'), ('WITH',''), ('WORD',''),('WRD','Wrd'), (
  752.                      'WRITE','Write'), ('WRITELN','Writeln'), ('XOR',''));
  753.  
  754.              LABEL
  755.                 bypass;
  756.  
  757.              VAR
  758.                 rw, rwbeyond: resword;
  759.                                    { loop index, limit }
  760.                 symword: rwstring; { copy of symbol word }
  761.                 i: 1..maxrwlen;    { loop index }
  762.                 high_index,low_index,key_index,select,key_size : INTEGER;
  763.                 test_keyword : STRING[keyword_len];
  764.  
  765.              BEGIN
  766.                 WITH WORD, inlinexx DO BEGIN
  767.                    size := index - base - 1;
  768.                    IF size < maxrwlen THEN BEGIN
  769.                       symword := '          ';
  770.                       FOR i := 1 TO size DO symword[i] := UpCase(buf[ base + i]
  771.                            );
  772.                       rw := firstrw[size];
  773.                       rwbeyond := firstrw[size + 1];
  774.                       symbol := semicolon;
  775.                       REPEAT
  776.                          IF rw >= rwbeyond THEN symbol := ident
  777.                          ELSE IF symword = rwword[rw] THEN symbol := rwsy[rw]
  778.                          ELSE rw := Succ (rw)
  779.                          UNTIL symbol <> semicolon;
  780.                       IF symbol = syend THEN BEGIN
  781.                          IF spaces < endspaces THEN spaces := endspaces;
  782.                          whenfirst := newclause   END   END;
  783.                                    {goto bypass;}
  784.                    IF size <= keyword_len THEN BEGIN
  785.                       FOR key_size := 1 TO size DO test_keyword[key_size] :=
  786.                            UpCase(buf[base+key_size]);
  787.                       test_keyword[0] := Chr(size);
  788.                       low_index := 1;
  789.                       high_index := keyword_size;
  790.                       WHILE low_index <= high_index DO BEGIN
  791.                          key_index := (high_index + low_index) DIV 2;
  792.                          IF keyword[key_index,1] = test_keyword THEN BEGIN
  793.                             IF keyword[key_index,2] = '' THEN select := 1
  794.                             ELSE select := 2;
  795.                             FOR key_size := 1 TO size DO buf[base+key_size] :=
  796.                                  keyword[key_index,select][key_size];
  797.                             low_index := high_index+1;
  798.                                    {terminate the loop}
  799.                             END
  800.                          ELSE IF keyword[key_index,1] > test_keyword THEN
  801.                               high_index := key_index - 1
  802.                          ELSE low_index := key_index + 1;
  803.                          END;
  804.                       END;
  805.                    bypass:;
  806.                    END;
  807.                 END;               { checkresword }
  808.  
  809.           PROCEDURE getname;
  810.  
  811.              BEGIN
  812.                 WHILE charclass[inlinexx.ch] IN [letter, digit] DO getchar;
  813.                 checkresword;
  814.                 END;               { getname }
  815.  
  816.           PROCEDURE getnumber;
  817.  
  818.              BEGIN
  819.                 WITH inlinexx DO BEGIN
  820.                    WHILE charclass[ch] = digit DO getchar;
  821.                    IF ch = '.' THEN BEGIN
  822.                                    { thanks to A.H.J.Sale, watch for '..' }
  823.                       IF charclass[nextchar] = digit THEN BEGIN
  824.                                    { NOTE: nextchar is a function! }
  825.                          symbol := otherword;
  826.                          getchar;
  827.                          WHILE charclass[ch] = digit DO getchar   END   END;
  828.                    IF UpCase (ch) = 'E' THEN BEGIN
  829.                       symbol := otherword;
  830.                       getchar;
  831.                       IF (ch = '+') OR (ch = '-') THEN getchar;
  832.                       WHILE charclass[ch] = digit DO getchar   END   END;
  833.                 END;               { getnumber }
  834.  
  835.           PROCEDURE getstringliteral;
  836.  
  837.              VAR
  838.                 endstring: BOOLEAN;{ end of string literal? }
  839.  
  840.              BEGIN
  841.                 WITH inlinexx DO BEGIN
  842.                    endstring := FALSE;
  843.                    REPEAT
  844.                       IF ch = '''' THEN BEGIN
  845.                          getchar;
  846.                          IF ch = '''' THEN getchar
  847.                          ELSE endstring := TRUE   END
  848.                       ELSE IF index >= len THEN BEGIN
  849.                                    { error, final "'" not on line }
  850.                          writeerror (notquote);
  851.                          symbol := syeof;
  852.                          endstring := TRUE   END
  853.                       ELSE getchar
  854.                       UNTIL endstring   END;
  855.                 END;               { getstringliteral }
  856.  
  857.           BEGIN                    { findsymbol }
  858.              startword (continue);
  859.              WITH inlinexx DO BEGIN
  860.                 IF endoffile THEN symbol := syeof
  861.                 ELSE BEGIN
  862.                    chclass := charclass[ch];
  863.                    symbol := symbolclass[chclass];
  864.                    getchar;        { second char }
  865.                    CASE chclass OF
  866.                       chsemicolon, chrightparen, chleftbrace, special, illegal:
  867.                            ;
  868.                       letter:  getname;
  869.                       digit:  getnumber;
  870.                       chapostrophe:  getstringliteral;
  871.                       chcolon:  BEGIN
  872.                          IF ch = '=' THEN BEGIN
  873.                             symbol := othersym;
  874.                             getchar   END   END;
  875.                       chlessthan:  BEGIN
  876.                          IF (ch = '=') OR (ch = '>') THEN getchar   END;
  877.                       chgreaterthan:  BEGIN
  878.                          IF ch = '=' THEN getchar   END;
  879.                       chleftparen:  BEGIN
  880.                          IF ch = '*' THEN BEGIN
  881.                             symbol := comment;
  882.                             getchar   END   END;
  883.                       chperiod:  BEGIN
  884.                          IF ch = '.' THEN BEGIN
  885.                             symbol := sysubrange;
  886.                             getchar   END   END   END   END   END;
  887.              finishword;
  888.              END;                  { findsymbol }
  889.  
  890.        BEGIN                       { getsymbol }
  891.           REPEAT
  892.              copysymbol (symbol, WORD);
  893.                                    { copy word for symbol to output }
  894.              findsymbol            { get next symbol }
  895.              UNTIL symbol <> comment;
  896.           END;                     { getsymbol }
  897.  
  898. { block performs recursive-descent syntax analysis with symbols,
  899.    adjusting margin, lnpending, word.whenfirst, and
  900.    word.blanklncount.  auxiliary procedures precede. }
  901.  
  902.     PROCEDURE startclause;         { (this may be a simple clause, or the start
  903.                                       of a header) }
  904.  
  905.        BEGIN
  906.           WORD.whenfirst := newclause;
  907.           lnpending := TRUE;
  908.           END;                     { startclause }
  909.  
  910.     PROCEDURE passsemicolons;      { pass consecutive semicolons }
  911.  
  912.        BEGIN
  913.           WHILE symbol = semicolon DO BEGIN
  914.              getsymbol;
  915.              startclause   END;    { new line after ';' }
  916.           END;                     { passsemicolons }
  917.  
  918.     PROCEDURE startpart;           { start program part }
  919.  
  920.        BEGIN
  921.           WITH WORD DO BEGIN
  922.              IF blanklncount = 0 THEN blanklncount := 1   END;
  923.           startclause;
  924.           END;                     { startpart }
  925.  
  926.     PROCEDURE startbody;           { finish header, start body of structure }
  927.  
  928.        BEGIN
  929.           passsemicolons;
  930.           margin := margin + indent;
  931.           startclause;
  932.           END;                     { startbody }
  933.  
  934.     PROCEDURE finishbody;
  935.  
  936.        BEGIN
  937.           margin := margin - indent;
  938.           END;                     { finishbody }
  939.  
  940.     PROCEDURE passphrase (finalsymbol: symboltype);
  941.                                    { process symbols until significant symbol
  942.                                       encountered }
  943.  
  944.        VAR
  945.           endsyms: symbolset;      { complete set of stopping symbols }
  946.  
  947.        BEGIN
  948.           IF symbol <> syeof THEN BEGIN
  949.              endsyms := stopsyms + [finalsymbol];
  950.              REPEAT
  951.                 getsymbol
  952.                 UNTIL symbol IN endsyms   END;
  953.           END;                     { passphrase }
  954.  
  955.     PROCEDURE expect (expectedsym: symboltype;
  956.          error: errortype;
  957.          syms: symbolset);
  958.  
  959.        BEGIN
  960.           IF symbol = expectedsym THEN getsymbol
  961.           ELSE BEGIN
  962.              writeerror (error);
  963.              WHILE NOT (symbol IN [expectedsym] + syms) DO getsymbol;
  964.              IF symbol = expectedsym THEN getsymbol   END;
  965.           END;                     { expect }
  966.  
  967.     PROCEDURE dolabel;             { process statement label }
  968.  
  969.        VAR
  970.           nextfirst: firstclass;   { (pass whenfirst to statement) }
  971.  
  972.        BEGIN
  973.           WITH WORD DO BEGIN
  974.              nextfirst := whenfirst;
  975.              whenfirst := stmtlabel;
  976.              lnpending := TRUE;
  977.              getsymbol;
  978.              expect (colon, notcolon, stopsyms);
  979.              whenfirst := nextfirst;
  980.              lnpending := TRUE   END;
  981.           END;                     { dolabel }
  982.  
  983.     PROCEDURE block;               { process block }
  984.  
  985.        PROCEDURE heading;          { process heading for program, procedure, or
  986.                                       function }
  987.  
  988.           PROCEDURE matchparens;   { process parentheses in heading }
  989.  
  990.              BEGIN
  991.                 getsymbol;
  992.                 WHILE NOT (symbol IN recendsyms) DO BEGIN
  993.                    IF symbol = leftparen THEN matchparens
  994.                    ELSE getsymbol   END;
  995.                 expect (rightparen, notparen, stopsyms + recendsyms);
  996.                 END;               { matchparens }
  997.  
  998.           BEGIN                    { heading }
  999.              getsymbol;
  1000.              passphrase (leftparen);
  1001.              IF symbol = leftparen THEN matchparens;
  1002.              IF symbol = colon THEN passphrase (semicolon);
  1003.              IF symbol = othersym THEN BEGIN
  1004.                                    {'['}
  1005.                 passphrase(semicolon);
  1006.                 IF symbol = othersym THEN passphrase(semicolon);
  1007.                                    {']'}
  1008.                 END;
  1009.              expect (semicolon, notsemicolon, stopsyms);
  1010.              END;                  { heading }
  1011.  
  1012.        PROCEDURE statement;        { process statement }
  1013.  
  1014.           FORWARD;
  1015.  
  1016.        PROCEDURE stmtlist;         { process sequence of statements }
  1017.  
  1018.           BEGIN
  1019.              REPEAT
  1020.                 statement;
  1021.                 passsemicolons
  1022.                 UNTIL symbol IN stmtendsyms;
  1023.              END;                  { stmtlist }
  1024.  
  1025.        PROCEDURE compoundstmt (    { process compound statement }
  1026.             stmtpart: BOOLEAN);    { statement part of block? }
  1027.  
  1028.           BEGIN
  1029.              getsymbol;
  1030.              startbody;            { new line, indent after 'BEGIN' }
  1031.              stmtlist;
  1032.              IF stmtpart AND NOT lnpending THEN Insert (semicolon);
  1033.              expect (syend, notend, stmtendsyms);
  1034.              finishbody;           { left-indent after 'END' }
  1035.              END;                  { compoundstmt }
  1036.  
  1037.        PROCEDURE statement;        { process statement }
  1038.  
  1039.           PROCEDURE checkcompound; { if structured then force compound }
  1040.  
  1041.              BEGIN
  1042.                 IF symbol = intconst THEN dolabel;
  1043.                 IF symbol IN strucsyms THEN BEGIN
  1044.                                    { force compound }
  1045.                                    {insert (sybegin);}
  1046.                    startbody;      { new line, indent after 'BEGIN' }
  1047.                    statement;      {insert (syend);}
  1048.                    finishbody   END{ left-indent after 'END' }
  1049.                 ELSE statement;
  1050.                 END;               { checkcompound }
  1051.  
  1052.           PROCEDURE ifstmt;        { process if statement }
  1053.  
  1054.              BEGIN
  1055.                 passphrase (sythen);
  1056.                 expect (sythen, notthen, stopsyms);
  1057.                 checkcompound;
  1058.                 IF symbol = syelse THEN BEGIN
  1059.                    startclause;    { new line before 'ELSE' }
  1060.                    getsymbol;
  1061.                    IF symbol = syif THEN ifstmt
  1062.                    ELSE checkcompound   END;
  1063.                 END;               { ifstmt }
  1064.  
  1065.           PROCEDURE repeatstmt;    { process repeat statement }
  1066.  
  1067.              BEGIN
  1068.                 getsymbol;
  1069.                 startbody;         { new line, indent after 'REPEAT' }
  1070.                 stmtlist;
  1071.                 startclause;       { new line before 'UNTIL' }
  1072.                 expect (syuntil, notuntil, stmtendsyms);
  1073.                 passphrase (semicolon);
  1074.                 finishbody;        { left-ident after 'UNTIL' }
  1075.                 END;               { repeatstmt }
  1076.  
  1077.           PROCEDURE fwwstmt;       { process for, while, or with statement }
  1078.  
  1079.              BEGIN
  1080.                 passphrase (sydo);
  1081.                 expect (sydo, notdo, stopsyms);
  1082.                 checkcompound;
  1083.                 END;               { fwwstmt }
  1084.  
  1085.           PROCEDURE casestmt;      { process case statement }
  1086.  
  1087.              BEGIN
  1088.                 passphrase (syof);
  1089.                 expect (syof, notof, stopsyms);
  1090.                 startbody;         { new line, indent after 'OF' }
  1091.                 REPEAT
  1092.                    IF symbol = syelse THEN symbol := syotherwise;
  1093.                    IF symbol <> syotherwise THEN BEGIN
  1094.                       passphrase (colon);
  1095.                       expect (colon, notcolon, stopsyms);
  1096.                       END;
  1097.                    checkcompound;
  1098.                    passsemicolons
  1099.                    UNTIL symbol IN (stopsyms - [syelse]);
  1100.                 expect (syend, notend, stmtendsyms);
  1101.                 finishbody;        { left-indent after 'END' }
  1102.                 END;               { casestmt }
  1103.  
  1104.           BEGIN                    { statement }
  1105.              IF symbol = intconst THEN dolabel;
  1106.              IF symbol IN stmtbeginsyms THEN BEGIN
  1107.                 CASE symbol OF
  1108.                    sybegin:       compoundstmt (FALSE);
  1109.                    sycase:        casestmt;
  1110.                    syif:          ifstmt;
  1111.                    syrepeat:      repeatstmt;
  1112.                    forwhilewith:  fwwstmt;
  1113.                    syotherwise:   BEGIN
  1114.                       getsymbol;
  1115.                       startbody;
  1116.                       stmtlist;
  1117.                       finishbody;
  1118.                       END;
  1119.                    ident, sygoto: passphrase (semicolon)   END   END;
  1120.              IF NOT (symbol IN stmtendsyms) THEN BEGIN
  1121.                 writeerror (notsemicolon);
  1122.                                    { ';' expected }
  1123.                 passphrase (semicolon)   END;
  1124.              END;                  { statement }
  1125.  
  1126.        PROCEDURE passfields (forvariant: BOOLEAN);
  1127.  
  1128.           FORWARD;
  1129.  
  1130.        PROCEDURE dorecord;         { process record declaration }
  1131.  
  1132.           BEGIN
  1133.              getsymbol;
  1134.              startbody;
  1135.              passfields (FALSE);
  1136.              expect (syend, notend, recendsyms);
  1137.              finishbody;
  1138.              END;                  { dorecord }
  1139.  
  1140.        PROCEDURE dovariant;        { process (case) variant part }
  1141.  
  1142.           BEGIN
  1143.              passphrase (syof);
  1144.              expect (syof, notof, stopsyms);
  1145.              startbody;
  1146.              passfields (TRUE);
  1147.              finishbody;
  1148.              END;                  { dovariant }
  1149.  
  1150.        PROCEDURE doparens (forvariant: BOOLEAN);
  1151.                                    { process parentheses in record }
  1152.  
  1153.           BEGIN
  1154.              getsymbol;
  1155.              IF forvariant THEN startbody;
  1156.              passfields (FALSE);
  1157.              lnpending := FALSE;   { for empty field list }
  1158.              expect (rightparen, notparen, recendsyms);
  1159.              IF forvariant THEN finishbody;
  1160.              END;                  { doparens }
  1161.  
  1162.        PROCEDURE passfields;       { process declarations }
  1163.                                    {     procedure passfields (forvariant:
  1164.                                       boolean); }
  1165.  
  1166.           BEGIN                    { passfields }
  1167.              WHILE NOT (symbol IN recendsyms) DO BEGIN
  1168.                 IF symbol = semicolon THEN passsemicolons
  1169.                 ELSE IF symbol = syrecord THEN dorecord
  1170.                 ELSE IF symbol = sycase THEN dovariant
  1171.                 ELSE IF symbol = leftparen THEN doparens (forvariant)
  1172.                 ELSE getsymbol   END;
  1173.              END;                  { passfields }
  1174.  
  1175.        BEGIN                       { block }
  1176.           WHILE symbol = declarator DO BEGIN
  1177.              startpart;            { label, const, type, var }
  1178.              getsymbol;
  1179.              startbody;
  1180.              REPEAT
  1181.                 passphrase (syrecord);
  1182.                 IF symbol = syrecord THEN dorecord;
  1183.                 IF symbol = semicolon THEN passsemicolons
  1184.                 UNTIL symbol IN headersyms;
  1185.              finishbody   END;
  1186.           WHILE symbol = progprocfunc DO BEGIN
  1187.              startpart;            { program, procedure, function }
  1188.              heading;
  1189.              startbody;
  1190.              IF symbol IN headersyms THEN block
  1191.              ELSE IF symbol = ident THEN BEGIN
  1192.                 startpart;         { directive: forward, etc. }
  1193.                 passphrase (semicolon);
  1194.                 passsemicolons   END
  1195.              ELSE writeerror (notbegin);
  1196.              finishbody   END;
  1197.           IF symbol = sybegin THEN BEGIN
  1198.              startpart;            { statement part }
  1199.              compoundstmt (TRUE);
  1200.              IF symbol IN [sysubrange, period] THEN symbol := semicolon;
  1201.                                    { treat final period as semicolon }
  1202.              passsemicolons   END;
  1203.           END;                     { block }
  1204.  
  1205.     PROCEDURE copyrem;             { copy remainder of input }
  1206.  
  1207.        BEGIN
  1208.           writeerror (noeof);
  1209.           WITH inlinexx DO BEGIN
  1210.              REPEAT
  1211.                 copyword (FALSE, WORD);
  1212.                 startword (contuncomm);
  1213.                 IF NOT endoffile THEN BEGIN
  1214.                    REPEAT
  1215.                       getchar
  1216.                       UNTIL ch = ' '   END;
  1217.                 finishword;
  1218.                 UNTIL endoffile   END;
  1219.           END;                     { copyrem }
  1220.  
  1221.     PROCEDURE initialize;          { initialize global variables }
  1222.  
  1223.        VAR
  1224.           i: 1..9;                 { loop index }
  1225.  
  1226.        BEGIN
  1227.           WITH inlinexx DO BEGIN
  1228.              FOR i := 1 TO 9 DO buf[i - 9] := instring[i];
  1229.                                    { string ';BEGINEND' in buf[-8..0] }
  1230.              endoffile := FALSE;
  1231.              ch := ' ';
  1232.              index := 0;
  1233.              len := 0   END;
  1234.           WITH outline DO BEGIN
  1235.              blanklns := 0;
  1236.              len := 0   END;
  1237.           WITH WORD DO BEGIN
  1238.              whenfirst := contuncomm;
  1239.              puncfollows := FALSE;
  1240.              blanklncount := 0;
  1241.              spaces := 0;
  1242.              base := 0;
  1243.              size := 0   END;
  1244.           margin := initmargin;
  1245.           lnpending := FALSE;
  1246.           symbol := othersym;
  1247.           END;                     { initialize }
  1248.  
  1249.     BEGIN                          { pascalformatter }
  1250.        IF (ParamCount<2) OR (ParamCount>3) THEN BEGIN
  1251.           Writeln('Incorrect # of parameters');
  1252.           Halt;
  1253.           END;
  1254.        IF ParamCount = 3 THEN no_error_output := FALSE
  1255.        ELSE no_error_output := TRUE;
  1256.        Assign(Input,ParamStr(1));
  1257.        Reset(Input);
  1258.        Assign(Output,ParamStr(2));
  1259.        Rewrite(Output);
  1260.        strucconsts;
  1261.        initialize;                 {  ***************  Files may be opened here.
  1262.                                       }
  1263.        getsymbol;
  1264.        block;
  1265.        IF NOT inlinexx.endoffile THEN copyrem;
  1266.        writeline;
  1267.        Write(Output,Chr(26));      {put EOF character}
  1268.        Close(Output);
  1269.        END                         { pascalformatter } .
  1270.